home *** CD-ROM | disk | FTP | other *** search
/ Chip 2004 July / Chip Temmuz 2004.iso / program / antispam / RazorAgent_SDK / razor-agents-sdk-2.03.exe / Digest-MD5-2.20 / t / files.t < prev    next >
Encoding:
Text File  |  2002-05-06  |  4.4 KB  |  180 lines
  1. BEGIN {
  2.     if ($ENV{PERL_CORE}) {
  3.             chdir 't' if -d 't';
  4.             @INC = '../lib';
  5.         }
  6. }
  7.  
  8. print "1..5\n";
  9.  
  10. use strict;
  11. use Digest::MD5 qw(md5 md5_hex md5_base64);
  12.  
  13. #
  14. # This is the output of: 'md5sum Changes README MD5.pm MD5.xs rfc1321.txt'
  15. #
  16. my $EXPECT;
  17.  
  18. # To update the EBCDIC section even on a Latin 1 platform,
  19. # run this script with $ENV{EBCDIC_MD5SUM} set to a true value.
  20. # (You'll need to have Perl 5.7.3 or later, to have the Encode installed.)
  21. # (And remember that under the Perl core distribution you should
  22. #  also have the $ENV{PERL_CORE} set to a true value.)
  23.  
  24. if (ord "A" == 193) { # EBCDIC
  25.     $EXPECT = <<EOT;
  26. b362148b17a451f0d81e0ebb2487756e Changes
  27. 5a591a47e8c40fe4b78c744111511c45 README
  28. 3157e2d2e27dacddea7c54efddc32520 MD5.pm
  29. 4850753428db9422e8e5f97b401d5a13 MD5.xs
  30. 276da0aa4e9a08b7fe09430c9c5690aa rfc1321.txt
  31. EOT
  32. } else {
  33.     $EXPECT = <<EOT;
  34. 0106b67df0dbf9f4d65e9fc04907745b  Changes
  35. 3519f3d02c7c91158f732f0f00064657  README
  36. 88c35ca46c7e8069fb5ae00c091c98d6  MD5.pm
  37. 1be293491bba726810f8e87671ee0328  MD5.xs
  38. 754b9db19f79dbc4992f7166eb0f37ce  rfc1321.txt
  39. EOT
  40. }
  41.  
  42. if (!(-f "README") && -f "../README") {
  43.    chdir("..") or die "Can't chdir: $!";
  44. }
  45.  
  46. my $testno = 0;
  47.  
  48. my $B64 = 1;
  49. eval { require MIME::Base64; };
  50. if ($@) {
  51.     print "# $@: Will not test base64 methods\n";
  52.     $B64 = 0;
  53. }
  54.  
  55. for (split /^/, $EXPECT) {
  56.      my($md5hex, $file) = split ' ';
  57.      my $base = $file;
  58.      if ($ENV{PERL_CORE}) {
  59.          if ($file eq 'rfc1321.txt') { # Don't have it in core.
  60.          print "ok ", ++$testno, " # Skip: PERL_CORE\n";
  61.          next;
  62.      }
  63.          use File::Spec;
  64.      my @path = qw(ext Digest MD5);
  65.      my $path = File::Spec->updir;
  66.      while (@path) {
  67.        $path = File::Spec->catdir($path, shift @path);
  68.      }
  69.      $file = File::Spec->catfile($path, $file);
  70.      }
  71. #     print "# file = $file\n";
  72.      unless (-f $file) {
  73.     warn "No such file: $file\n";
  74.     next;
  75.      }
  76.      if ($ENV{EBCDIC_MD5SUM}) {
  77.          require Encode;
  78.      my $data = cat_file($file);    
  79.      Encode::from_to($data, 'latin1', 'cp1047');
  80.      print md5_hex($data), " $base\n";
  81.      next;
  82.      }
  83.      my $md5bin = pack("H*", $md5hex);
  84.      my $md5b64;
  85.      if ($B64) {
  86.      $md5b64 = MIME::Base64::encode($md5bin, "");
  87.      chop($md5b64); chop($md5b64);   # remove padding
  88.      }
  89.      my $failed;
  90.      my $got;
  91.  
  92.      if (digest_file($file, 'digest') ne $md5bin) {
  93.      print "$file: Bad digest\n";
  94.      $failed++;
  95.      }
  96.  
  97.      if (($got = digest_file($file, 'hexdigest')) ne $md5hex) {
  98.      print "$file: Bad hexdigest: got $got expected $md5hex\n";
  99.      $failed++;
  100.      }
  101.  
  102.      if ($B64 && digest_file($file, 'b64digest') ne $md5b64) {
  103.      print "$file: Bad b64digest\n";
  104.      $failed++;
  105.      }
  106.  
  107.      my $data = cat_file($file);
  108.      if (md5($data) ne $md5bin) {
  109.      print "$file: md5() failed\n";
  110.      $failed++;
  111.      }
  112.      if (md5_hex($data) ne $md5hex) {
  113.      print "$file: md5_hex() failed\n";
  114.      $failed++;
  115.      }
  116.      if ($B64 && md5_base64($data) ne $md5b64) {
  117.      print "$file: md5_base64() failed\n";
  118.      $failed++;
  119.      }
  120.  
  121.      if (Digest::MD5->new->add($data)->digest ne $md5bin) {
  122.      print "$file: MD5->new->add(...)->digest failed\n";
  123.      $failed++;
  124.      }
  125.      if (Digest::MD5->new->add($data)->hexdigest ne $md5hex) {
  126.      print "$file: MD5->new->add(...)->hexdigest failed\n";
  127.      $failed++;
  128.      }
  129.      if ($B64 && Digest::MD5->new->add($data)->b64digest ne $md5b64) {
  130.      print "$file: MD5->new->add(...)->b64digest failed\n";
  131.      $failed++;
  132.      }
  133.  
  134.      my @data = split //, $data;
  135.      if (md5(@data) ne $md5bin) {
  136.      print "$file: md5(\@data) failed\n";
  137.      $failed++;
  138.      }
  139.      if (Digest::MD5->new->add(@data)->digest ne $md5bin) {
  140.      print "$file: MD5->new->add(\@data)->digest failed\n";
  141.      $failed++;
  142.      }
  143.      my $md5 = Digest::MD5->new;
  144.      for (@data) {
  145.      $md5->add($_);
  146.      }
  147.      if ($md5->digest ne $md5bin) {
  148.      print "$file: $md5->add()-loop failed\n";
  149.      $failed++;
  150.      }
  151.  
  152.      print "not " if $failed;
  153.      print "ok ", ++$testno, "\n";
  154. }
  155.  
  156.  
  157. sub digest_file
  158. {
  159.     my($file, $method) = @_;
  160.     $method ||= "digest";
  161.     #print "$file $method\n";
  162.  
  163.     open(FILE, $file) or die "Can't open $file: $!";
  164.     my $digest = Digest::MD5->new->addfile(*FILE)->$method();
  165.     close(FILE);
  166.  
  167.     $digest;
  168. }
  169.  
  170. sub cat_file
  171. {
  172.     my($file) = @_;
  173.     local $/;  # slurp
  174.     open(FILE, $file) or die "Can't open $file: $!";
  175.     my $tmp = <FILE>;
  176.     close(FILE);
  177.     $tmp;
  178. }
  179.  
  180.